170 IF FRE(3)>260000 THEN DIM PICBAK(122880):PICBAK=1:LINE(200,385)-(420,411),PSET,6,B:A$="UNDO機能が使用できます":IF OP(12)=1 THEN SYMBOL(50,220),A$,1,1,6 ELSE SYMBOL(205,390),A$,1,1,6:WAIT 99
180 MJC=0:BI!=1:IF CC<0 OR INKEY$<>"" THEN 200
190 DEF FONT S12$:MJC=1:BI!=.75!
200 IF OP(12)=0 THEN FOR A=0 TO 220:LINE(100+A,100+A)-(540-A,415-A),PSET,0,B:NEXT:SCREEN 1,0 ELSE WAIT 200
510 LINE(0,0)-(119,23),PSET,7,BF:FOR A=0 TO 1:FOR B=0 TO 3:LINE(B*16,A*16)-(B*16+15,A*16+15),PSET,7,B:NEXT:NEXT:SYMBOL(1,1),"16326496",.75!,.75!,0:SYMBOL(4,13),"2 3 612",.75!,.75!,0:SYMBOL(84,1),"点",.75!,.75!,0:SYMBOL(84,13),"調",.75!,.75!,0
770 CRX=53+OP(9):CRX=RX(OP(9))-(OP(8)=1)*97:CRY=RY(OP(9)):RX=INT(CX-160/OP(9))/2:RY=INT(CY-120/OP(9)):RX=(OP(8)=1)*(RX>CRX-1)*CRX+RX*(RX>0 AND RX<CRX)*(OP(8)=1)+(OP(8)=0 AND OP(9)>1)*(RX>0 AND RX<CRX)*RX+(OP(8)=0 AND OP(9)>1)*(RX>CRX-1)*CRX
780 RY=-(RY>0 AND RY<CRY)*RY-(RY>CRY-1)*CRY:OUT &H440,17:OUT &H442,RX:OUT &H443,RY
880 IF PE<2 THEN LINE(CX+84,CY+14+QC+PE*12)-(CX+94,CY+25+QC+PE*12),PSET,[PE*255,255,0],BF ELSE IF PE=2 THEN LINE(CX+108,CY+14+QC)-(CX+119,CY+25+QC),PSET,[0,255,0],BF
1010 FOR A=0 TO 2:LINE(CX+4+A*30,CY+14)-(CX+30+A*30,CY+20),PSET,0,BF,[CO(A,0),CO(A,1),CO(A,2)]:NEXT:FOR A=0 TO 2:LINE(CX+3,CY+22+A*6)-(CX+91,CY+27+A*6),PSET,0,BF,3-A-(A=0):NEXT
1020 FOR A=0 TO 9:LINE(CX+1+A*9,CY+40)-(CX+11+A*9,CY+49),PSET,0,BF,[COC(A,0),COC(A,1),COC(A,2)]:NEXT:FOR A=0 TO 2:LINE(CX+4+CO(2,A)/3,CY+23+A*6)-(CX+7+CO(2,A)/3,CY+26+A*6),PSET,7,B:NEXT
1240 GOSUB *コメント:CX=INT(CX/SI)*SI:CY=INT(CY/SI)*SI:IF IX<>CX OR IY<>CY THEN LINE(IX,IY)-(IX+LP-1,IY+LP-1),XOR,7,B:LINE(CX,CY)-(CX+LP-1,CY+LP-1),XOR,7,B:IX=CX:IY=CY
1520 IF MOUSE(2,0)=-1 THEN C1=0 ELSE IF MOUSE(2,1)=-1 THEN C1=1 ELSE C1=2
1530 IF WC(0)=1 AND WX(0)<CX AND WY(0)+12<CY AND WX(0)+W2X(0)>CX AND WY(0)+W2Y(0)>CY AND C1<>2 THEN CCX=CX-WX(0):CCY=CY-WY(0):GOTO *ルーペ
1540 '★ICONチェック
1550 IF ICWI=1 THEN
1560 CC=-1:FOR A=0 TO 9:IF WC(A)>0 AND WX(A)<CX AND WY(A)+12<CY AND WX(A)+W2X(A)>CX AND WY(A)+W2Y(A)-2>CY THEN CC=A:A=9
1570 NEXT:IF CC=-1 THEN ICW3=0:IF ICW1=-1 AND TIME=TIM! THEN 1770 ELSE LINE(208,1)-(348,14),PSET,7,BF:SYMBOL(210,2+(MJC=0)*2),"時刻 "+TIME$,BI!,BI!,[96,96,96]:ICW1=-1:TIM!=TIME:GOTO 1770
1580 ICW1=-1:ICW2=0
1590 IF WC(CC)=3 OR WC(CC)=4 THEN ICW1=WC(CC)-1:ICW2=INT((CX-WX(CC))/16)
1600 IF WC(CC)=5 THEN ICW1=4:ICW2=INT((CX-WX(CC))/16)+INT((CY-WY(CC)-12)/16)*10
1640 IF CCX>4 AND CCX<30 THEN ICW2=1:EM$(1,1)="("+STR$(CO(0,0))+","+STR$(CO(0,1))+","+STR$(CO(0,2))+")"
1650 IF CCX>34 AND CCX<60 THEN ICW2=2:EM$(1,2)="("+STR$(CO(1,0))+","+STR$(CO(1,1))+","+STR$(CO(1,2))+")"
1660 IF CCX>64 AND CCX<90 THEN ICW2=3:EM$(1,3)="("+STR$(CO(2,0))+","+STR$(CO(2,1))+","+STR$(CO(2,2))+")"
1670 ELSE
1680 ENDIF
1690 ELSE
1700 ENDIF
1710 IF WC(CC)=1 THEN
1720 ICW1=0:CCX=CX-WX(CC):CCY=CY-WY(CC):IF CCX<47 AND CCY>LP*LP2+14 THEN ICW2=INT(CCX/12)+INT((CCY-LP*LP2-14)/12)*4
1730 IF CCX>80 AND CCY>LP*LP2+14 AND CCX<116 THEN ICW2=8+INT((CCX-84)/12)+INT((CCY-LP*LP2-14)/12)*3
1740 ENDIF
1750 IF NOT(ICW1=ICW3 AND ICW2=ICW4) AND ICW1>-1 AND ICW2>-1 THEN LINE(208,1)-(348,14),PSET,7,BF:SYMBOL(210,2+(MJC=0)*2),EM$(ICW1,ICW2),BI!,BI!,[96,96,96]:ICW3=ICW1:ICW4=ICW2
1760 ENDIF
1770 IF C1=2 THEN 1510
1780 IF CY<16 THEN
1790 IF CX<80 THEN CC=6:GOSUB *G1:WX(0)=0:WY(0)=20:W2X(0)=100:W2Y(0)=50:GOSUB *E6:GOTO *MAIN
1800 IF CX>80 AND CX<207 THEN ON INT((CX-80)/16)+1 GOTO 1200,1220,1280,1310,1330,1350
1900 DEF FONT S16$:SYMBOL(258,50),"制作 元内 康博",1,1,%13,,,4:WAIT 99
1910 IF MOUSE(2,0)=-1 OR MOUSE(2,1)=-1 THEN SCREEN@1:GOSUB *W1:GOTO *MAIN
1920 FOR A=0 TO 16:FOR B=2 TO 0 STEP -1:LINE(190+A*16,87)-(214+A*16,111),PSET,7,BF:SYMBOL(190+A*16+B*8,95+B*8),KMID$(" 又の御使用を、お待ちしております。",A+2+(B=2),1),1,1,%14,B,,4:WAIT 3:NEXT:NEXT:SYSTEM
1930 ELSE
1940 GOSUB *W1:GOTO *MAIN
1950 ENDIF
1960 ENDIF
1970 WC=0
1980 IF NOT(WX(WC)<CX AND WX(WC)+W2X(WC)>CX AND WY(WC)<CY AND WY(WC)+W2Y(WC)>CY) THEN WC=WC+1:IF WC<10 THEN 1980 ELSE WC=0:GOTO *MAIN
1990 *WINDOW
2000 WCC=0
2010 IF WC>0 THEN SWAP WX(WC),WX(0):SWAP WY(WC),WY(0):SWAP W2X(WC),W2X(0):SWAP W2Y(WC),W2Y(0):SWAP WC(WC),WC(0):SWAP WX(WC),WX(1):SWAP WY(WC),WY(1):SWAP W2X(WC),W2X(1):SWAP W2Y(WC),W2Y(1):SWAP WC(WC),WC(1):WC=0:WCC=1
2020 CCX=CX-WX(WC):CCY=CY-WY(WC)
2030 IF CCY<13 THEN
2040 IF CCX<12 THEN
2050 IF WC(0)=7 THEN ICWI=0
2060 FOR G=1 TO 9:WC(G-1)=WC(G):WX(G-1)=WX(G):WY(G-1)=WY(G):W2X(G-1)=W2X(G):W2Y(G-1)=W2Y(G):NEXT
2070 ELSE
2080 SCREEN 1,0:DEF PEN 0,1
2090 CX=MOUSE(0)-CCX:CY=MOUSE(1)-CCY:FOR A=0 TO 1:SCREEN 1,A:LINE(CX,CY)-(CX+W2X(0)-1,CY+W2Y(0)-1),XOR,7,B:NEXT:WAIT 3:FOR A=0 TO 1:SCREEN 1,A:LINE(CX,CY)-(CX+W2X(0)-1,CY+W2Y(0)-1),XOR,7,B:NEXT
2300 CC!=(CX+C1X)*2+(CY+C1Y)*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):CO(C1,2)=(C3 AND 31)*8:CO(C1,0)=((C2 AND 127)-(C2 AND 3))*2:CO(C1,1)=INT(((C2 AND 3)*64+(C3/8)*2)/8)*8
2310 IF COC2=C1 THEN COC(COC,0)=CO(C1,0):COC(COC,1)=CO(C1,1):COC(COC,2)=CO(C1,2)
2320 SCREEN 1,1:FOR A=0 TO 9:IF WC(A)=2 THEN LINE(WX(A)+4+C1*30,WY(A)+14)-(WX(A)+30+C1*30,WY(A)+20),PSET,0,BF,[CO(C1,0),CO(C1,1),CO(C1,2)]:LINE(WX(A)+2+COC*9,WY(A)+41)-(WX(A)+9+COC*9,WY(A)+48),PSET,[CO(C1,0),CO(C1,1),CO(C1,2)],BF
2370 IF PE<>1 AND OP(10)>1 THEN SCREEN 1,0:GET@A(C1X,C1Y)-(C1X+LP-1,C1Y+LP-1),PIC:SCREEN 1,1:PUT@A(WX(0)+1,WY(0)+13)-(WX(0)+LP,WY(0)+12+LP),PIC,,LP2,LP2
2380 GOTO 1510
2390 ELSE
2400 '★サイズ
2410 IF CCX<47 AND CCY>LP*LP2+14 AND CCY<LP*LP2+26 THEN
2420 CX=INT(CCX/12)+1:LP=CX*16:IF CX=3 THEN LP=64 ELSE IF CX=4 THEN LP=96
2840 IF CCX>96 AND CCY>LP*LP2+13 AND CCX<107 AND CCY<LP*LP2+25 THEN LPC=0:GOSUB *W1
2850 IF CCX>96 AND CCY>LP*LP2+25 AND CCX<107 AND CCY<LP*LP2+37 THEN LPC=1:LPC2=1-LPC2:GOSUB *W1
2860 IF CCX>108 AND CCY>LP*LP2+25 AND CCX<119 AND CCY<LP*LP2+37 THEN LPC3=1-LPC3:LINE(WX(0)+108,WY(0)+LP*LP2+25)-(WX(0)+119,WY(0)+LP*LP2+36),XOR,7,BF
2870 ENDIF
2880 GOTO *MAIN
2890 *カラー
2900 IF CCX>4 AND CCY>22 AND CCY<40 THEN
2910 CX=INT((CCX-5)/3)*9:CY=INT((CCY-22)/6)
2920 CO(2,CY)=INT(CX/8)*8:IF CO(2,CY)>248 THEN CO(2,CY)=248
2930 LINE(WX(0)+64,WY(0)+14)-(WX(0)+90,WY(0)+20),PSET,0,BF,[CO(2,0),CO(2,1),CO(2,2)]:FOR A=0 TO 2:LINE(WX(0)+3,WY(0)+22+A*6)-(WX(0)+91,WY(0)+27+A*6),PSET,0,BF,3-A-(A=0):NEXT
2940 FOR A=0 TO 2:LINE(WX(0)+4+CO(2,A)/3,WY(0)+23+A*6)-(WX(0)+7+CO(2,A)/3,WY(0)+26+A*6),PSET,7,B:NEXT:GOTO *MAIN
2950 ENDIF
2960 IF CCY>14 AND CCY<20 THEN
2970 IF CCX>68 AND CCX<96 THEN
2980 FOR A=0 TO 2:LINE(WX(0)+3,WY(0)+22+A*6)-(WX(0)+91,WY(0)+27+A*6),PSET,0,BF,3-A-(A=0):NEXT
2990 CO(2,0)=CO(C1,0):CO(2,1)=CO(C1,1):CO(2,2)=CO(C1,2):LINE(WX(0)+64,WY(0)+14)-(WX(0)+90,WY(0)+20),PSET,0,BF,[CO(2,0),CO(2,1),CO(2,2)]:FOR A=0 TO 2:LINE(WX(0)+4+CO(2,A)/3,WY(0)+23+A*6)-(WX(0)+7+CO(2,A)/3,WY(0)+26+A*6),PSET,7,B:NEXT:GOTO *MAIN
3030 IF COC2=0 THEN COC(COC,0)=CO(0,0):COC(COC,1)=CO(0,1):COC(COC,2)=CO(0,2):LINE(WX(0)+2+COC*9,WY(0)+41)-(WX(0)+9+COC*9,WY(0)+48),PSET,[CO(0,0),CO(0,1),CO(0,2)],BF
3070 IF COC2=1 THEN COC(COC,0)=CO(1,0):COC(COC,1)=CO(1,1):COC(COC,2)=CO(1,2):LINE(WX(0)+2+COC*9,WY(0)+41)-(WX(0)+9+COC*9,WY(0)+48),PSET,[CO(1,0),CO(1,1),CO(1,2)],BF
3080 ENDIF
3090 ENDIF
3100 IF CCY>40 AND CCX>1 AND CCX<90 AND CCY<49 THEN
3180 IF CCY=3 AND JP=1 THEN MOUSE 1,,,0:SCREEN 0:BEEP:SYMBOL(0,0),"メモリが足りません。他のSAVEを使用してください。",.75!,.75!,2:Q$=INPUT$(1):GOTO 3600
3190 MOUSE 1,,,0:SCREEN 0:CONSOLE 0,24,2:PRINT "ドライブ名?";:A$=INPUT$(1):IF A$=CHR$(13) THEN 3600
3200 CC=ASC(A$):IF CC>96 THEN CC=CC-32:A$=CHR$(CC)
3210 IF A$="Q" AND CCY>1 THEN PRINT "Qドライブには書き込めません":GOTO 3190
3220 PRINT A$:IF CC<65 OR CC>81 THEN 3190
3230 PRINT KMID$(" LOAD SAVE 圧縮SAVEJPEGSAVE JPEGLOAD",CCY*9-8,9)
3240 ON ERROR GOTO *ER1:SHELL A$+":":PRINT :IF DIR=0 THEN FILES"*.*" ELSE IF DIR=1 THEN IF CCY<4 THEN FILES"*.TIF" ELSE FILES"*.JPG"
3250 IF MEM$<>"" THEN PRINT "前回入力したファイル名 ";MEM$
3260 PRINT "命令一覧: CD (ディレクトリ変更) DIR (拡張子判別の"+MID$("ON OFF",1+DIR*3,3)+")"
3270 LINE INPUT "ファイル or 命令? ";F$:IF LEFT$(F$,2)="CD" OR LEFT$(F$,2)="cd" THEN SHELL F$:GOTO 3240
3280 IF RIGHT$(F$,1)=":" THEN A$=LEFT$(F$,1):GOTO 3240
3290 IF LEFT$(F$,3)="DIR" THEN DIR=1-DIR:GOTO 3240
3300 IF F$="" THEN 3600
3310 IF CCY=4 THEN
3320 INPUT "圧縮比率(1 OR 2 OR 4)";Y1:IF Y1<>1 AND Y1<>2 AND Y1<>4 THEN 3320
3330 INPUT "輝度成分(0-100)";Y2:IF Y2<0 OR Y2>100 THEN 3330
3340 INPUT "色成分 (0-100)";Y3:IF Y3<0 OR Y3>100 THEN 3340
3350 ENDIF
3360 SCREEN 1,1:SCREEN @1:ON ERROR GOTO *ER2:WINDOW(0,0)-(511,239):VIEW(0,0)-(511,239):SCREEN 1,0:WINDOW(0,0)-(511,239):VIEW(0,0)-(511,239):PUT@A(0,0)-(319,239),PIC:MEM$=F$:IF CCY>1 AND CCY<5 THEN 3530
3370 SCREEN 1,1:DEF FONT S16$:LINE(50,50)-(200,170),PSET,[128,128,128],BF:SYMBOL(71,51),"読み込み方",1,1,6:SYMBOL(51,71),"普通",1,1,7:SYMBOL(51,91),"黒色を除く",1,1,7:SYMBOL(51,111),"左色を除く",1,1,7
3480 SCREEN 1,0:IF QC=1 THEN PUT@A(0,0)-(319,239),PIC,MATTE,,,[0,0,0]:IF OP(8)=1 THEN SCREEN 1,1:GET@A(320,0)-(511,239),PIC:SCREEN 1,0:PUT@A(320,0)-(511,239),PIC,MATTE,,,[0,0,0]
3490 IF QC=2 THEN PUT@A(0,0)-(319,239),PIC,MATTE,,,[CO(0,0),CO(0,1),CO(0,2)]:IF OP(8)=1 THEN SCREEN 1,1:GET@A(320,0)-(511,239),PIC:SCREEN 1,0:PUT@A(320,0)-(511,239),PIC,MATTE,,,[CO(0,0),CO(0,1),CO(0,2)]
3500 IF QC=3 THEN PUT@A(0,0)-(319,239),PIC,PASTEL:IF OP(8)=1 THEN SCREEN 1,1:GET@A(320,0)-(511,239),PIC:SCREEN 1,0:PUT@A(320,0)-(511,239),PIC,PASTEL
3510 IF QC=4 THEN SCREEN 1,1:GET@(0,0)-(511,239),PIC,[CO(0,0),CO(0,1),CO(0,2)]:SCREEN 1,0:PUT@(0,0)-(511,239),PIC,PSET,[CO(0,0),CO(0,1),CO(0,2)]
3540 GOSUB *コメント:CX=INT((CX+1)/SI)*SI-1:CY=INT((CY+1)/SI)*SI-1:IF CX<>IX OR CY<>IY THEN LINE(0,0)-(IX,IY),XOR,7,B:LINE(0,0)-(CX,CY),XOR,7,B:IX=CX:IY=CY
3550 IF MOUSE(2,1)=-1 THEN LINE(0,0)-(CX,CY),XOR,7,B:GOTO 3600
3560 IF MOUSE(2,0)=0 THEN 3540
3570 LINE(0,0)-(CX,CY),XOR,7,B:MOUSE 1,,,0:SCREEN 1,0:IF CCY=3 THEN 3620
3950 LINE(10,20)-(310,225),PSET,7,BF:LINE(10,20)-(21,31),PSET,[96,96,96],BF:LINE(10,20)-(21,31),PSET,0:MOUSE 1,,,0:MOUSE 4,10,20,310,225:DEF FONT S16$
3960 FOR A=0 TO 2:LINE(40+A*72,20)-(111+A*72,34),PSET,7,BF,[96,96,96]:NEXT:SYMBOL(41,21),"データーのSAVE 色の初期化 オプション初期化",.75!,.75!,0:LINE(260,20)-(300,33),PSET,[96,96,96],BF:SYMBOL(260,20),"ページ",1,1,0
4530 GOSUB *コメント:CX=INT(CX/SI)*SI:CY=INT(CY/SI)*SI:IF CX<>IX OR CY<>IY THEN LINE(IX,IY)-(IX+CCX,IY+CCY),XOR,7,B:LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B:IX=CX:IY=CY
4540 IF MOUSE(2,1)=-1 THEN LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B:IF CC<2 THEN GOSUB *W1:GOTO *MAIN ELSE 4630
4550 IF MOUSE(2,0)=0 THEN 4530
4560 LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B:CX(CC)=CX:CY(CC)=CY:WAIT 20:IF CC>0 THEN 4620
4570 GOSUB *コメント:CX=INT((CX+1)/SI)*SI-1:CY=INT((CY+1)/SI)*SI-1:LINE(CX(0),CY(0))-(CX,CY),XOR,7,B:LINE(CX(0),CY(0))-(CX,CY),XOR,7,B:IF MOUSE(2,1)=-1 THEN GOSUB *W1:GOTO *MAIN
4580 IF MOUSE(2,0)=0 THEN 4570
4590 IF CX<CX(0) OR CY<CY(0) THEN 4510
4600 CCX=CX-CX(0):CCY=CY-CY(0):CC=1:SIZ!=FNSIZ!(CCX,CCY):IF SIZ!>38400 THEN SE$="範囲が広すぎます。指定を続行しますか":GOSUB *YN:IF QC=0 THEN 4510 ELSE GOSUB *W1:GOTO *MAIN
4610 GOTO 4520
4620 CC=CC+1:IF SIZ!*(CC+1)>76800 OR CC>99 THEN CC=CC-1 ELSE 4520
4630 SCREEN 1,0:FOR A=0 TO CC:GET@A(CX(A),CY(A))-(CX(A)+CCX,CY(A)+CCY),PIC,SIZ!*A:NEXT:SCREEN 1,1:GOSUB *CLS:LINE(159-(CCX+1)/2,119-(CCY+1)/2)-(160+(CCX+1)/2,120+(CCY+1)/2),PSET,7,BF:A=0
4640 PUT@A(160-(CCX+1)/2,120-(CCY+1)/2)-(159+(CCX+1)/2,119+(CCY+1)/2),PIC,,,,,SIZ!*A:WAIT OP(7):A=A+1:IF A=CC THEN A=0
4650 IF MOUSE(2,1)=-1 THEN GOSUB *W1:GOTO *MAIN ELSE 4640
4660 *編集
4670 SE$="":QC=INT(CCX/16)+INT((CCY-12)/16)*10+1:SCREEN 1,0:IF PICBAK=1 AND QC<>20 THEN GET@A(0,0)-(511,239),PICBAK
4680 IF QC=17 THEN 4720
4690 GOSUB *コメ:WAIT 20:IF QC=3 OR QC=6 OR QC=7 THEN 5080 ELSE 4760
4820 GOSUB *コメント:CX=INT(CX/SI)*SI:CY=INT(CY/SI)*SI:IF CX<>IX OR CY<>IY THEN LINE(IX,IY)-(IX+SI,IY+SI),XOR,7,B:LINE(CX,CY)-(CX+SI,CY+SI),XOR,7,B:IX=CX:IY=CY
4830 IF MOUSE(2,1)=-1 THEN LINE(CX,CY)-(CX+SI,CY+SI),XOR,7,B:GOTO 4700
4860 GOSUB *コメント:CX=INT((CX+1)/SI)*SI-1:CY=INT((CY+1)/SI)*SI-1:IF CX<>IX OR CY<>IY THEN LINE(CCX,CCY)-(IX,IY),XOR,7,B:LINE(CCX,CCY)-(CX,CY),XOR,7,B:IX=CX:IY=CY
4870 IF MOUSE(2,1)=-1 THEN LINE(CCX,CCY)-(CX,CY),XOR,7,B:GOTO 4700
4880 IF MOUSE(2,0)=0 THEN 4860
4890 LINE(CCX,CCY)-(CX,CY),XOR,7,B:IF QC=4 THEN LINE(CX,CY)-(CCX,CCY),PSET,[CO(C1,0),CO(C1,1),CO(C1,2)],BF:GOTO 4700
4900 IF QC=5 THEN LINE(CX,CY)-(CCX,CCY),PSET,[CO(C1,0),CO(C1,1),CO(C1,2)],B:GOTO 4700
4910 IF QC=17 THEN 5240
4920 IF (CX-CCX)*(CY-CCY)>76800 OR CCX>CX OR CCY>CY THEN 4810
5030 GOSUB *コメント:CX=INT(CX/SI)*SI:CY=INT(CY/SI)*SI:IF CX<>IX OR CY<>IY THEN LINE(IX,IY)-(IX+CCX,IY+CCY),XOR,7,B:LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B:IX=CX:IY=CY
5040 IF MOUSE(2,1)=-1 THEN LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B:GOTO 4700
5310 SCREEN 1,1:MOUSE 0,1:MOUSE 1,,,1:DEF FONT S16$:LINE(50,50)-(200,110),PSET,7,BF:SYMBOL(71,51),"特別処理",1,1,1:SYMBOL(51,70),"ぼかし処理",1,1,0:SYMBOL(51,90),"モノクロ",1,1,0:GOSUB *形状:MOUSE 4,50,70,200,109
5320 CX=MOUSE(0):CY=MOUSE(1)
5330 IF MOUSE(2,1)=-1 THEN 4700
5340 IF MOUSE(2,0)=0 THEN 5320
5350 CY=INT((CY-70)/20):MOUSE 1,,,0:LINE(CHX,CHY)-(CHX+CCX,CHY+CCY),PSET,0,BF:IF CY=1 THEN 5430
5360 C4=-(OP(8)=1)*512-(OP(8)=0)*320:FOR Y=CHY TO CHY+CCY:FOR X=CHX TO CHX+CCX:C=1
5370 CC!=X*2+Y*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):B=(C3 AND 31):G=((C2 AND 127)-(C2 AND 3)):R=INT(((C2 AND 3)*64+(C3/8)*2)/8)
5380 FOR A1=-1 TO 1 STEP 2:FOR A2=-1 TO 1 STEP 2
5390 IF X+A2>-1 AND X+A2<C4 AND Y+A1>-1 AND Y+A1<240 THEN CC!=(X+A2)*2+Y*1024:C3=PEEK([&H1C]CC!):B=B+(C3 AND 31):C2=PEEK([&H1C]CC!+1):G=G+((C2 AND 127)-(C2 AND 3)):R=R+INT(((C2 AND 3)*64+(C3/8)*2)/8):C=C+1
5430 FOR Y=CHY TO CHY+CCY:FOR X=CHX TO CHX+CCX:CC!=X*2+Y*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):B=(C3 AND 31)*8:G=((C2 AND 127)-(C2 AND 3))*2:R=INT(((C2 AND 3)*64+(C3/8)*2)/8)*8
5750 GOSUB *コメント:CX=INT(CX/SI)*SI:CY=INT(CY/SI)*SI:IF CX<>IX OR CY<>IY THEN LINE(IX,IY)-(IX+CCX*BX!,IY+CCY*BY!),XOR,7,B:LINE(CX,CY)-(CX+CCX*BX!,CY+CCY*BY!),XOR,7,B:IX=CX:IY=CY
5760 IF MOUSE(2,1)=-1 THEN LINE(CX,CY)-(CX+CCX*BX!,CY+CCY*BY!),XOR,7,B:GOTO 4700
5770 IF MOUSE(2,0)=0 THEN 5750
5780 LINE(CX,CY)-(CX+CCX*BX!,CY+CCY*BY!),XOR,7,B:IF C1=0 THEN PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC,,BX!,BY!
5790 IF C1=1 THEN PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC,MATTE,BX!,BY!,[CO(0,0),CO(0,1),CO(0,2)]
5800 IF C1=2 THEN PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC,PASTEL,BX!,BY!
5840 CY=INT((MOUSE(1)-100)/13):IF MOUSE(2,1)=-1 THEN 4700
5850 IF MOUSE(2,0)=0 THEN 5840
5860 MOUSE 1,,,0:LINE(0,0)-(319,239),PSET,[0,0,0,1],BF:SCREEN 1,0:IF CY=1 THEN 5880
5870 FOR A=CCY TO 0 STEP -1:PUT@A(CHX,CHY+CCY-A)-(CHX+CCX,CHY+CCY-A),PIC,,,,,(CCX+1)*A:NEXT:GOTO 4700
5880 CC=CCY+1:FOR A=CCX TO 0 STEP -1:GET@A(CHX+A,CHY)-(CHX+A,CHY+CCY),PIC,(CCY+1)*CCX-CC*A:NEXT:FOR A=0 TO CCX:PUT@A(CHX+A,CHY)-(CHX+A,CHY+CCY),PIC,,,,,CC*A:NEXT:GOTO 4700
5890 *入替え
5900 MOUSE 1,,,0
5910 FOR A=CHX TO CHX+CCX:FOR C=CHY TO CHY+CCY
5920 CC!=A*2+C*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):B=(C3 AND 31)*8:G=((C2 AND 127)-(C2 AND 3))*2:R=INT(((C2 AND 3)*64+INT(C3/8)*2)/8)*8
5930 C1=G-CO(0,0):C2=R-CO(0,1):C3=B-CO(0,2):IF ABS(C1)<=OP(2) AND ABS(C2)<=OP(3) AND ABS(C3)<=OP(4) THEN
5940 IF OP(5)=0 THEN Y1=CO(1,0):Y2=CO(1,1):Y3=CO(1,2) ELSE Y1=CO(1,0)+C1:Y2=CO(1,1)+C2:Y3=CO(1,2)+C3:Y1=-(Y1<256 AND Y1>0)*Y1-(Y1>255)*255:Y2=-(Y2<256 AND Y2>0)*Y2-(Y2>255)*255:Y3=-(Y3<256 AND Y3>0)*Y3-(Y3>255)*255
6170 CC!=INT(BX!)*2+INT(BY!)*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):B=(C3 AND 31)*8:G=((C2 AND 127)-(C2 AND 3))*2:R=INT(((C2 AND 3)*64+INT(C3/8)*2)/8)*8:PSET(C,A),[G,R,B]:NEXT:NEXT
6220 G=0:R=0:B=0:FOR GY=-1 TO 1:FOR GX=-1 TO 1:Y1!=ABS(GX-BX!+INT(BX!)):Y2!=ABS(GY-BY!+INT(BY!))
6230 IF Y1!<=1 AND Y2!<=1 THEN Y1!=((1-Y1!)+(1-Y2!))/2:CC!=INT(BX!+GX)*2+INT(BY!+GY)*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):B=B+(C3 AND 31)*8*Y1!:G=G+(((C2 AND 127)-(C2 AND 3))*2)*Y1!:R=R+INT(((C2 AND 3)*64+INT(C3/8)*2)/8)*8*Y1!
6650 CX=MOUSE(0)-130:CY=MOUSE(1)-130:IF MOUSE(2,1)=-1 THEN IF BA!=1 THEN 4700 ELSE 6710
6660 IF MOUSE(2,0)=0 THEN 6650
6670 IF CY<0 OR CY>19 OR CX<0 THEN 6650
6680 IF CX<20 THEN BA!=BA!-.1!:IF BA!<.1! THEN BA!=.1!
6690 IF CX>70 AND CX<90 THEN BA!=BA!+.11!
6700 BA!=INT(BA!*10)/10:GOTO 6640
6710 LINE(0,0)-(319,239),PSET,[0,0,0,1],BF
6720 SCREEN 1,0:FOR A=CHX TO CHX+CCX:FOR C=CHY TO CHY+CCY:CC!=A*2+C*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):B=(C3 AND 31)*8:G=((C2 AND 127)-(C2 AND 3))*2:R=INT(((C2 AND 3)*64+(C3/8)*2)/8)*8
6860 MOUSE 1,,,0:FOR A=CHX TO CHX+CCX:FOR C=CHY TO CHY+CCY:CC!=A*2+C*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):IF C2=0 AND C3=0 THEN POKE [&H1C]CC!+1,128
6870 NEXT:NEXT:GOTO 4700
6880 *CLS
6890 LINE(0,0)-(319,239),PSET,0,BF:RETURN
6900 *復活
6910 IF PICBAK=1 THEN SE$="絵を元に戻していいですか。":GOSUB *YN:IF QC=0 THEN SCREEN 1,0:PUT@A(0,0)-(511,239),PICBAK